목차

1. 주제

2. 조별 구성원

3. 주제 선정 목적

4. 데이터 출처

5. 데이터 설명

6. 사용한 R 패키지

7. 모형생성 및 적합

8. 결론

9. 느낀점 및 한계점

10. 부록

1. 주제

영화 관객 수 예측

2. 조별 구성원

배윤희, 최병현, 현인경

3. 주제 선정 목적

기생충의 아카데미상 수상에 따라 위상이 높아진 한국영화의 흥행요인과 관객 수에 영향을 미치는 항목을 알아보고, 회귀모형을 통해 최근 상영이 종료된 영화의 관객수를 예측 및 비교해봄.

5. 데이터 설명

구분 칼럼명 칼럼내용 변수타입 추가설명
movieCd 영화코드 chr 다른 데이터와 붙이기 위한 key 값
movieNm 영화 이름 chr
openDt 개봉일 POSIXct
입력변수 nations 국가 Factor Levels : 미국 제3국 한국
입력변수 scrnCnt 상영횟수 num
목표변수 audiCnt 관객수 num
입력변수 watchGrade 영화등급 Factor Levels : 12세이상관람가 15세관람가 15세이상관람가 전체관람가 청소년관람불가
입력변수 showTm 상영시간 int
입력변수 genre 장르 Factor Levels : SF 공포(호러) 드라마 뮤지컬 미스터리 범죄 사극 스릴러 애니메이션 액션 어드벤처 전쟁 코미디 판타지
company 배급사 chr
direct 감독 chr
파생변수 actor1 배우1 chr
파생변수 actor2 배우2 chr actors 배우가 한명만 존재시 NA값으로 생성
파생변수 actor3 배우3 chr actors 배우가 한명 혹은 두명만 존재시 NA값으로 생성
파생변수 actor1_audiCnt_mean 배우1 평균 관객수 num
파생변수 actor2_audiCnt_mean 배우2 평균 관객수 num
파생변수 actor3_audiCnt_mean 배우3 평균 관객수 num
파생변수 month 월 chr 계절을 구분하기 위해 생성
파생변수 week 요일 Factor Levels : Fri Mon Sat Sun Thu Tue Wed
파생변수 season 계절 Factor Levels : 가을 겨울 봄 여름
입력 / 파생변수 cmopany_score 배급사 평균 관객수 num
입력 / 파생변수 season_score 계절 평균 관객수 num
입력 / 파생변수 week_score 요일 평균 관객수 num
입력 / 파생변수 actor_score 배우1 배우2 배우3 총 합 평균 관객수 num 배우1 가중치 : 0.5배우2 가중치 : 0.3배우3 가중치 : 0.2
입력 / 파생변수 direct_score 감독 평균 관객수 num


5-1. 관람등급별 영화 개봉편수

# 관람등급 확인 시 청소년관람 불가 비율이 많음.


5-2. 관람등급별 관객수

# 개봉영화 건수와는 다르게 12세이상 관람가의 영화가 가장 관객수가 많음


5-3. 제작국가별 영화 개봉편수

# 한국/미국/일본 3개국의 다수의 영화가 개봉됨


5-4. 제작국가별 관객수

# 한국.미국영화의 관객수가 압도적으로 많고, 일본과 기타 국가의 경우 개봉편수에 비해 관객수가 매우 적음을 알 수 있음


5-5. 장르별 영화 개봉편수

# 개봉영화는 드라마 > 멜로/로맨스 > 액션 순으로 나타남


5-6. 장르별 관객수

# 관객 수는 액션 > 드라마 > 애니메이션 순서


5-7. 상영시간별 영화 편수

# 1시간 이상 ~ 2시간 미만 상영시간이 압도적으로 높다.


5-8. 상영시간별 관객수

# 하지만 관객들은 2시간이상 3시간 미만 영화를 더 관람하였다.


## # A tibble: 6 x 2
##   영화명                           상영시간
##   <chr>                               <dbl>
## 1 오페라-장미의 기사                    285
## 2 오페라-아르미다 (메트로폴리탄)        244
## 3 파르지팔                              270
## 4 윌리엄 텔                             257
## 5 돈 카를로                             249
## 6 반지의 제왕 : 왕의 귀환 (확장판)      263
# 상영시간 4시간 이상 영화 리스트


5-9. 배우별 영화 출연편수


# 3D Bar Plot로 확인해 본 결과, 주연배우 중에서도 메인급인 배우가 다작을 했음을 알 수 있음
## # A tibble: 14 x 2
##    배우            `10년간 작품수`
##    <chr>                     <int>
##  1 맷 데이먼                    15
##  2 마동석                       14
##  3 엄상현                       13
##  4 드웨인 존슨                  12
##  5 리암 니슨                    12
##  6 황정민                       12
##  7 설경구                       11
##  8 조니 뎁                      11
##  9 마이클 패스벤더               9
## 10 성룡                          9
## 11 니콜라스 케이지               8
## 12 에단 호크                     8
## 13 견자단                        6
## 14 브루스 윌리스                 4
# 10년간 작품수 확인결과 국내 유명배우 중에서는 마동석이 가장 많이 찍음


5-10. 감독-배우별 네트워크맵

# 감독과 배우별로 네트워크맵을 그려봄


6. 사용한 R 패키지

library(randomForest)
library(gbm)

7. 모형생성 및 적합

<데이터 분할>

# 80%를 훈련용, 20%를 시험용 데이터로 분리


<1. Random Forest>

grid <- expand.grid(ntree = c(300, 500, 700, 1000),
                    mtry = c(3, 4, 5, 6, 7),
                    mse = NA)


  1. 최적 파라미터 확인 
##    ntree mtry          mse
## 12  1000    5 564718480550
# 나무의 수와 입력변수의 수를 총 20가지 조합으로 생성하여 에러가 최소인 모형을 찾아봄
# MSE가 최소인 나무수 1,000개 / 입력변수의 수 5개가 베스트 파라미터로 확인됨


  1. 최적 회귀모형 적합
##                 %IncMSE    IncNodePurity
## nations        7.047095   15732797310126
## scrnCnt       35.936007  871011772027924
## watchGrade     3.895950   43527468791189
## showTm         5.855517  129483030542111
## genre          2.214558  189394418145071
## company_score 11.910634  137635631284968
## season_score   0.864144   35916170346832
## week_score     4.626522   20798531342190
## actor_score   62.551722 2870075043538558
## direct_score  46.721333 1622501597389618

# 변수의 중요도가 배우 > 감독 > 스크린수 > 배급사 순으로 나타남


  1. 최적 모형의 성능평가
##   RF_RMSE RF_MAPE
## 1  526987    1.01
# 시험셋으로 목표변수의 추정값을 확인해보고 RMSE, MAPE를 구해봄. MAPE가 1.02으로 랜덤포레스트 회귀모형이 실제값을 예측할 수 있음


<2. Gradient Boosting Machine>

grid <- expand.grid(depth = c(1, 3, 5),
                    learn = c(0.01, 0.05, 0.10),
                    min = c(5, 7, 10),
                    bag = c(0.5, 0.8, 1.0),
                    rmse = NA,
                    tree = NA)


  1. 최적 파라미터 확인
## [1] 78
##    depth learn min bag   rmse tree
## 78     5  0.05  10   1 729124  100
# 나무의 깊이, 학습률, 최소관측값, 샘플링 비중을 총 81가지 조합으로 생성하여 에러가 최소인 모형을 찾아봄
# RMSE가 최소인 베스트 파라미터로 확인


  1. 최적 회귀모형 적합 
##                         var rel.inf
## actor_score     actor_score 67.3741
## direct_score   direct_score 21.9524
## scrnCnt             scrnCnt  8.3274
## genre                 genre  1.0995
## showTm               showTm  1.0116
## season_score   season_score  0.1323
## company_score company_score  0.0674
## nations             nations  0.0221
## watchGrade       watchGrade  0.0132
## week_score       week_score  0.0000
# 변수의 중요도가 배우 > 감독 > 스크린수 > 배급사 순으로 나타남


  1. 최적 모형의 성능평가
##   GBM_RMSE GBM_MAPE
## 1   577120     1.71
# 시험셋으로 목표변수의 추정값을 확인해보고 RMSE, MAPE를 구해봄. MAPE가 1.706으로 GBM 회귀모형이 실제값을 예측할 수 있음

8. 결론

##   nations scrnCnt audiCnt     watchGrade showTm  genre company_score
## 1    한국    1948      NA 15세이상관람가    131 드라마       2014121
## 2    한국    1128      NA 15세이상관람가    125     SF       2014121
## 3    한국     976      NA 15세이상관람가    125   액션       2014121
## 4    한국    1183      NA 15세이상관람가    105   액션       1793032
##   season_score week_score actor_score direct_score
## 1       258989     181709     1474136      6440557
## 2       402692     181709     1616655      6440557
## 3       355186     867177      755997      2883691
## 4       402692     867177      201696       773293
##  [1] "SF"         "공포(호러)" "드라마"     "뮤지컬"     "미스터리"  
##  [6] "범죄"       "사극"       "스릴러"     "애니메이션" "액션"      
## [11] "어드벤처"   "전쟁"       "코미디"     "판타지"
## [1] "한국" "한국" "한국" "한국"
## [1] "미국"  "제3국" "한국"
##  [1] "12세이상관람가"                "12세이상관람가,15세이상관람가"
##  [3] "12세이상관람가,전체관람가"     "15세관람가"                   
##  [5] "15세관람가,12세이상관람가"     "15세이상관람가"               
##  [7] "15세이상관람가,전체관람가"     "전체관람가"                   
##  [9] "청소년관람불가"                "청소년관람불가,15세이상관람가"
##  [1] "SF"         "공포(호러)" "드라마"     "뮤지컬"     "미스터리"  
##  [6] "범죄"       "사극"       "스릴러"     "애니메이션" "액션"      
## [11] "어드벤처"   "전쟁"       "코미디"     "판타지"
##    movieCd  movieNm Real_audiCnt pred_RF pred_GBM diff_RF diff_GBM
## 1 20183782   기생충     10085275 9149226  9279702  936049   805573
## 2 20126674 설국열차      8914845 8484259  9359709  430586  -444864
## 3 20151228     공조      7817446 5502090  3876518 2315356  3940928
## 4 20156554     물괴       723414  834992   974815 -111578  -251401
# 4개영화를 임의로 선정해서 각 모델을 통해 관객수를 예측해봄.
　

　

　

　

# 공조의 경우 예측값과 실제값의 차이가 큰데, 이는 같은날에 개봉한 대작인 더킹의 영향이 큼. 이는 천만가량의 관객파이를 두 영화가 나눠가지면서 나타난 결과라고 봄.


9. 느낀점 및 한계점

천만배우라는 말이 괜히 나온게 아닌것처럼 관객동원에 있어서 주연배우의 영향도가 크다는 것을 알 수 있었음.
다만, 영화 내적인 요소 외에 다른 변수들(네이버 네티즌 영화 평점, 댓글 갯수, 개봉당시 경쟁작 존재여부 등)을 고려해보지 못한 점은 아쉬움으로 남음.

10. 부록

apikey <- 'dcb81e6219b6a0ac87e910ff8bd0633c' #윤희1
apikey <- '839d48649cc43a32c5f9d01aec3f56da' #윤희2
apikey <- 'd7f02bb7237005c899c18505ddca7686' #병현1
apikey <- '93ccb7d8bf1e51c51c971a94df598ee0' #병현2
apikey <- 'bfbc2f2b7f61114c0419e52a835c18ed' #병현3
apikey <- '55187da05e5ca80981f646c7b8edbf65' #병현4

# 1. 2010~2019 개봉영화 리스트 수집----
# 일일 api 요청횟수 3000건 제한으로 연도별 분할하여 수집

mlist <- NULL
for(i in 1:123){
  cat(i, '번째 페이지 수집중.\n')
  res <- GET(url = 'http://www.kobis.or.kr/kobisopenapi/webservice/rest/movie/searchMovieList.json',
             query = list('key' = apikey,
            'curPage' = i,
            'itemPerPage' = 100,
            'openStartDt' = 2010,
            'openEndDt' = 2019))
  tmp <- res %>% content(as = 'text') %>% fromJSON()
  mlist <- rbind(mlist, tmp$movieListResult$movieList)
}
mcd <- mlist$movieCd

# 2. 해당하는 영화 상세정보 수집----
mvdata <- NULL

for(i in 1:length(mcd)){
  res <- GET(url = 'http://www.kobis.or.kr/kobisopenapi/webservice/rest/movie/searchMovieInfo.json',
             query = list('key' = apikey,
                          'movieCd' = mcd[i]))
  tmp <- res %>% content(as = 'text') %>% fromJSON()
  
# 필요한 컬럼만 골라내서 mvdata에 적재
  cat(i,"번째 수집완료!\n")
  
  movie_Cd <- tmp$movieInfoResult$movieInfo$movieCd
  showTm   <- tmp$movieInfoResult$movieInfo$showTm
  actor    <- tryCatch(tmp$movieInfoResult$movieInfo$actors$peopleNm[c(1,2,3)], error=function(e){})
  gen      <- tmp$movieInfoResult$movieInfo$genres$genreNm
  direct   <- tmp$movieInfoResult$movieInfo$directors$peopleNm
  company  <- tryCatch(tmp$movieInfoResult$movieInfo$companys
        [which(tmp$movieInfoResult$movieInfo$companys$companyPartNm == '배급사'),]$companyNm,
        error=function(e){})
  mvset    <- cbind(list(movie_Cd), list(showTm), list(actor), list(gen), list(direct), list(company))
  mvdata   <- rbind(mvdata, mvset)
}

# 데이터프레임으로 변경
mvdata <- as.data.frame(mvdata)
colnames(mvdata1214) <- c("movie_Cd", "showTm", "actor", "gen" ,"direct" ,"company")

# 연도별 데이터를 하나로 합침
mvdata_all <- rbind.data.frame(mvdata1214, mvdata2015, mvdata2016, mvdata2017, mvdata2018, mvdata2019)

# 배우명/장르/감독/회사 없는 컬럼 제거
mvdata_all %>% 
  dplyr::filter((actor != "NULL")
                & (gen != "NULL")
                & (direct != "NULL") 
                & (company != "NULL")) -> mvdata_all

# 리스트 형태로 묶인 장르/배우/감독정보 구분 및 변수생성
for(i in 1: nrow(x = mvdata_all2)){
  mvdata_all2$genre[i] <- mvdata_all2$gen[[i]][1]
  mvdata_all2$actor1[i] <- mvdata_all2$actor[[i]][1]
  mvdata_all2$actor2[i] <- mvdata_all2$actor[[i]][2]
  mvdata_all2$actor3[i] <- mvdata_all2$actor[[i]][3]
  mvdata_all2$direct1[i] <- mvdata_all2$direct[[i]][1]
  mvdata_all2$company1[i] <- mvdata_all2$company[[i]][1]
}

# 컬럼 구조 확인
str(mvdata_all2)

# 형변환
mvdata_all2[1:2] <- map_df(.x = mvdata_all2[1:2],
                           .f = as.character)

# 불필요 컬럼 제거
mvdata_all %>% 
  dplyr::select(c(1,2,7:12)) -> mvdata_all

# 변수명 재설정
colnames(mvdata_all) <- c("movieCd", "showTm", "genre", "actor1", "actor2", "actor3", "direct" ,"company")

# 3. 영화별 실적 불러와서 영화정보 합치기----
KOBIS <- read_xlsx(path = 'KOBIS.xlsx')

# movieCd기준으로 innerjoin
rawdata <- inner_join(x = KOBIS,
                      y = mvinfo,
                      by = 'movieCd')

# 4. 각 변수별 평균매출, 평균관중수 산출 ----
ed <- readRDS(file = 'EDA.RDS')
ed[, 15:27] <- NULL

# 관객수 10000명 이상인 영화만 기준으로 필터링
ed1 <- ed %>%
  dplyr::filter(audiCnt >= 10000)

# actor1 ----
ed1$actor1_mean <- NA
for(i in 1:nrow(ed1)){
  print(paste("i = ", i))
  df <- data.frame()
  for(j in 1:nrow(ed1)){
    # print(paste('>>j = ', j))
    if(ed1$openDt[i] > ed1$openDt[j]){
      df <- rbind(df, ed1[j, ])
    }
  }
  print(paste('>>j = ', j))
  if(dim(df)[1] != 0){
    df %>%
      group_by(actor1) %>%
      mutate(actor1_mean = mean(audiCnt)) -> df
    for(k in 1:nrow(df)){
      # print(paste('>>>> k = ', k))
      if(ed1$actor1[i] == df$actor1[k]){
        ed1$actor1_mean[i] = df$actor1_mean[k]
      }
    }
    print(paste('>>>> k = ', k))
  }
  if(is.na(ed1$actor1_mean[i])){
    print(paste('NO SAME NAME : ', i))
    ed1$actor1_mean[i] = ed1$audiCnt[i]
  }
}

# actor2 ---
ed2 <- ed1
ed2$actor2_mean <- NA
for(i in 1:nrow(ed2)){
  if(is.na(ed2$actor2[i])){
    ed2$actor2_mean = 0
  }
  else{
    print(paste("i = ", i))
    df <- data.frame()
    for(j in 1:nrow(ed2)){
      # print(paste('>>j = ', j))
      if(ed2$openDt[i] > ed2$openDt[j]){
        df <- rbind(df, ed2[j, ])
      }
    }
    print(paste('>>j = ', j))
    if(dim(df)[1] != 0){
      df %>%
        group_by(actor2) %>%
        mutate(actor2_mean = mean(audiCnt)) -> df
      for(k in 1:nrow(df)){
        print(paste('>>>> k = ', k))
        if(!is.na(df$actor2[k])){
          if(ed2$actor2[i] == df$actor2[k]){
            ed2$actor2_mean[i] = df$actor2_mean[k]
          }
        }
      }
      print(paste('>>>> k = ', k))
    }
    if(is.na(ed2$actor2_mean[i])){
      print(paste('NO SAME NAME : ', i))
      ed2$actor2_mean[i] = ed2$audiCnt[i]
    }
  }
}

# actor3 ---
ed3 <- ed2
ed3$actor3_mean <- NA
for(i in 1:nrow(ed3)){
  if(is.na(ed3$actor3[i])){
    ed3$actor3_mean = 0
  }
  else{
    print(paste("i = ", i))
    df <- data.frame()
    for(j in 1:nrow(ed3)){
      # print(paste('>>j = ', j))
      if(ed3$openDt[i] > ed3$openDt[j]){
        df <- rbind(df, ed3[j, ])
      }
    }
    print(paste('>>j = ', j))
    if(dim(df)[1] != 0){
      df %>%
        group_by(actor3) %>%
        mutate(actor3_mean = mean(audiCnt)) -> df
      for(k in 1:nrow(df)){
        print(paste('>>>> k = ', k))
        if(!is.na(df$actor3[k])){
          if(ed3$actor3[i] == df$actor3[k]){
            ed3$actor3_mean[i] = df$actor3_mean[k]
          }
        }
      }
      print(paste('>>>> k = ', k))
    }
    if(is.na(ed3$actor3_mean[i])){
      print(paste('NO SAME NAME : ', i))
      ed3$actor3_mean[i] = ed3$audiCnt[i]
    }
  }
}


# direct ----
ed4 <- ed3
ed4$direct_mean <- NA
for(i in 1:nrow(ed4)){
  if(is.na(ed4$direct[i])){
    ed4$direct_mean = 0
  }
  else{
    print(paste("i = ", i))
    df <- data.frame()
    for(j in 1:nrow(ed4)){
      # print(paste('>>j = ', j))
      if(ed4$openDt[i] > ed4$openDt[j]){
        df <- rbind(df, ed4[j, ])
      }
    }
    print(paste('>>j = ', j))
    if(dim(df)[1] != 0){
      df %>%
        group_by(direct) %>%
        mutate(direct_mean = mean(audiCnt)) -> df
      for(k in 1:nrow(df)){
        print(paste('>>>> k = ', k))
        if(!is.na(df$direct[k])){
          if(ed4$direct[i] == df$direct[k]){
            ed4$direct_mean[i] = df$direct_mean[k]
          }
        }
      }
      print(paste('>>>> k = ', k))
    }
    if(is.na(ed4$direct_mean[i])){
      print(paste('NO SAME NAME : ', i))
      ed4$direct_mean[i] = ed4$audiCnt[i]
    }
  }
}

write_xlsx(x = ed1,
           path = 'ed1.xlsx')

# 최종 rawdata 저장
rawdata_fin <- read_xlsx(path = 'fin.xlsx')
rawdata_finas.data.frame(rawdata_fin)

saveRDS(object = rawdata_fin,
        file = 'rawdata_fin.RDS')


# 파생변수 생성 및 전처리 ----
total_data <- readRDS(file = 'rawdata_fin.RDS')
total_data <- as.data.frame(total_data)

# 장르별 평균 관객동원이 10000이하인 장르 데이터 제거
total_data %>% group_by(genre) %>% mutate(genre_cnt = mean(audiCnt)) %>% 
  select(genre, genre_cnt) %>% 
  arrange(desc(genre_cnt)) %>% unique() %>% 
  dplyr::filter(genre_cnt >= 100000) -> list

total_data <- total_data %>% 
  dplyr::filter(genre %in% list$genre)

# 미국/한국/제3국 분류
total_data$nations[total_data$nations != '미국' &
                     total_data$nations != '한국'] = '제3국'

# 월, 요일 파생변수 생성
as.character(total_data$openDt, '%m') -> total_data$month
as.character(total_data$openDt, '%a') -> total_data$week
total_data <- total_data %>%
  mutate(season = ifelse(month %in% c('03','04','05'),
                         yes = '봄',
                         ifelse(month %in% c('06','07','08'),
                                yes = '여름',
                                ifelse(month %in% c('09','10','11'),
                                       yes = '가을',
                                       no = '겨울'))))

# 배급사, 계절, 요일 스코어 파생변수 생성
total_data <-  total_data %>% group_by(company) %>% mutate(company_score = mean(audiCnt))
total_data <-  total_data %>% group_by(season) %>% mutate(season_score = mean(audiCnt))
total_data <-  total_data %>% group_by(week) %>% mutate(week_score = mean(audiCnt))


# 주연배우 1,2,3 가중평균 스코어 산출(배우스코어)
total_data <-  total_data %>%
  mutate(actor_score = (actor1_mean * 0.5 + actor2_mean * 0.3 + actor3_mean * 0.2) / 3,
         direct_score =  direct_mean * 1)

# 문자형변수 팩터로 변환
total_data$nations <- as.factor(total_data$nations)
total_data$genre <- as.factor(total_data$genre)
total_data$watchGrade <- as.factor(total_data$watchGrade)
total_data$showTm <- as.integer(total_data$showTm)
total_data$season <- as.factor(total_data$season)
total_data$week <- as.factor(total_data$week)

total_data <- as.data.frame(x = total_data)

saveRDS(object = total_data,
        file = 'total.RDS')

# total_data <- readRDS(file = 'total.RDS')


# 머신러닝 모델링에 불필요한 변수들 제거(총 11개만 남겨둠)
total_data <-  total_data %>%
  select(-c(movieCd, movieNm, openDt, sales, actor1, actor2, actor3, direct, company,
            actor1_mean, actor2_mean, actor3_mean, direct_mean, month, week, season))

saveRDS(object = total_data,
        file = 'total.RDS')

# 여기서부터 읽음(12/19 16:50)
total_data <- readRDS(file = 'total.RDS')
options(scipen = 100)


# 훈련셋 테스트셋 8:2 비중으로 분류
set.seed(seed = 1234)
index <- sample(x = nrow(total_data),
                size = nrow(total_data) * 0.8,
                replace = FALSE)
trainSet <- total_data[index, ]
testSet <- total_data[-index, ]

# 예측모형도 미리 만들어줌
predi <- read_xlsx(path = 'pred.xlsx')
as.data.frame(predi)

predi$audiCnt <- 10

# 각 변수별로 레벨을 설정해줌.
levels(trainSet$genre)

predi$nations <- factor(predi$nations, levels=c("미국","제3국","한국"))
predi$watchGrade <- factor(predi$watchGrade, levels=c("12세이상관람가",
                                                "12세이상관람가,15세이상관람가",
                                                "12세이상관람가,전체관람가",
                                                "15세관람가",
                                                "15세관람가,12세이상관람가",
                                                "15세이상관람가",
                                                "15세이상관람가,전체관람가",
                                                "전체관람가",
                                                "청소년관람불가",
                                                "청소년관람불가,15세이상관람가"))
predi$genre <- factor(predi$genre, levels=c("SF",
                                            "공포(호러)",
                                            "드라마",
                                            "뮤지컬",
                                            "미스터리",
                                            "범죄",
                                            "사극",
                                            "스릴러",
                                            "애니메이션",
                                            "액션",
                                            "어드벤처",
                                            "전쟁",
                                            "코미디",
                                            "판타지"))
levels(predi$nations)
levels(predi$watchGrade)
levels(predi$genre)

# 레벨설정 후 팩터화 
predi$nations <- as.factor(predi$nations)
predi$genre <- as.factor(predi$genre)
predi$watchGrade <- as.factor(predi$watchGrade)
predi$showTm <- as.integer(predi$showTm)



# 모델링
library(randomForest)
library(generics)


real <- testSet$audiCnt
grid <- expand.grid(depth = c(1, 3, 5),
                    learn = c(0.01, 0.05, 0.10),
                    min = c(5, 7, 10),
                    bag = c(0.5, 0.8, 1.0),
                    rmse = NA,
                    tree = NA)

for(i in 1:nrow(x = grid)){
  set.seed(seed = 1234)
  fit <- gbm(formula = audiCnt ~ .,
             data = trainSet,
             distribution = 'gaussian',
             n.trees = 5000,
             interaction.depth = grid$depth[i],
             shrinkage = grid$learn[i],
             n.minobsinnode = grid$min[i],
             bag.fraction = grid$bag[i],
             train.fraction = 0.75)
  grid$rmse[i] <- fit$valid.error %>% min %>% sqrt()
  grid$tree[i] <- which.min(x = fit$valid.error)
}

loc <- which.min(x = grid$rmse); print(x = loc)
betsPara <- grid[loc,]

set.seed(seed = 1234)
fit1 <- gbm(formula = audiCnt ~ .,
           data = trainSet,
           distribution = 'gaussian',
           n.trees = betsPara$tree,
           interaction.depth = betsPara$depth,
           shrinkage = betsPara$learn,
           n.minobsinnode = betsPara$min,
           bag.fraction = betsPara$bag,
           train.fraction = 0.75)

print(x = fit1)
par(mar = c(5,11,4,2))
summary(object = fit1, las = 2)

pred1 <- predict(object = fit1,
                  newdata = testSet,
                  n.trees = betsPara$tree)

preddd <- predict(object = fit1,
                 newdata = predi,
                 n.trees = betsPara$tree)

view(preddd)

error1 <- real - pred1

rmse1 <- error1^2 %>% mean() %>% sqrt()
mape1 <- (abs(x = error1) / abs(x = real)) %>% mean()

trainSet2 <- na.omit(object = trainSet)

# 랜덤포레스트
grid <- expand.grid(ntree = c(300, 500, 700, 1000),
                    mtry = c(3,4,5,6,7),
                    mse = NA)

for(i in 1:nrow(x = grid)){
  set.seed(seed = 1234)
  fit <- randomForest(x = trainSet2[, -3],
                       y = trainSet2[, 3],
                       ntree = grid[i, 'ntree'],
                       mtry = grid[i, 'mtry'])
  grid$mse[i] <- tail(x = fit$mse, n = 1)
}

loc <- which.min(x = grid$mse); print(x = loc)

bestPa <- grid[loc,]

set.seed(seed = 1234)
fit2 <- randomForest(x = trainSet[, -3],
                     y = trainSet[, 3],
                     ntree = bestPa$ntree,
                     mtry = bestPa$mtry)

importance(x = fit2)
varImpPlot(x = fit2)

print(x = fit2)
plot(x = fit2)
summary(fit2)

pred2 <- predict(object = fit2,
                 newdata = testSet,
                 type = 'response')

predd <- predict(object = fit2,
                 newdata = predi,
                 type = 'response')

view(predd)

view(predi)

error2 <- real - pred2

rmse2 <- error2^2 %>% mean() %>% sqrt()
mape2 <- (abs(x = error2) / abs(x = real)) %>% mean()



# 네트워크맵 그려보기
mv <- read_xlsx('bh2.xlsx')
mv <- as_tbl_graph(mv)

par(family = 'AppleGothic')
mv %>%
  as_tbl_graph() %>%
  ggraph(layout='kk') + 
  geom_node_text(aes(label=name),
                 family = 'AppleGothic') +
  geom_edge_link(aes(start_cap = label_rect(node1.name), end_cap = label_rect(node2.name)))